home *** CD-ROM | disk | FTP | other *** search
/ Merciful 5 / Merciful - Disc 5.iso / software / p / pcqpascalv1.2d.lha / Examples2 / Speak / speak.p < prev    next >
Encoding:
Text File  |  1997-05-06  |  3.7 KB  |  132 lines
  1. Program Speak;
  2.  
  3. { * Coded 1993 by Diesel - this piece of cake is public domain * }
  4.  
  5. {$I "Include:Exec/Memory.i"          }
  6. {$I "Include:Exec/Devices.i"         }
  7. {$I "Include:devices/Narrator.i"     }
  8. {$I "Include:libraries/Translator.i" }
  9. {$I "Include:utils/IOutils.i"        }
  10. {$I "Include:utils/Stringlib.i"      }
  11.  
  12. VAR
  13.     txt    : String;
  14.     i, OpDv,
  15.     error    : Integer;
  16.     Sport    : MsgPortPtr;
  17.     Sreq    : Narrator_rbPtr;
  18.     Xbuf    : ARRAY[0..500] OF CHAR;
  19.     channels: ARRAY[0..3]   OF Byte;
  20.  
  21.  
  22.  
  23. Function CreateExtIO( iop : MsgPortPtr; iosize : Integer) : Address;
  24. Var
  25.   ExtIO : IOStdReqPtr;
  26.  
  27. Begin
  28.   If iop = NIl then CreateExtIO := NIL;
  29.   ExtIO := AllocMem( iosize, Memf_Public+Memf_Clear );
  30.   If ExtIO = NIL then CreateExtIO := NIL;
  31.  
  32.   With ExtIO^.io_message do begin
  33.     mn_node.ln_Type := NTMessage;
  34.     mn_Length := iosize;
  35.     mn_ReplyPort := iop;
  36.   End;
  37.   CreateExtIO := ExtIO;
  38. End;
  39.  
  40.  
  41. Procedure DeleteExtIO( iorp : IOStdReqPtr );
  42. Begin
  43.   With iorp^ do begin
  44.     io_Message.mn_node.ln_Type := $ff;
  45.     io_Device := Address( -1 );        { * Verstümmeln *}
  46.     io_Unit   := Address( -1 );
  47.   End;
  48.   FreeMem( iorp, iorp^.io_Message.mn_Length );    { * Speicher freigeben * }
  49. End;
  50.  
  51.  
  52.  
  53. Procedure CleanExit( why : String; rt : Integer);
  54. Begin
  55.   If  TranslatorBase <> NIL then CloseLibrary(TranslatorBase);
  56.   If  OpDv  <> 0   then CloseDevice( Sreq );
  57.   If  Sreq  <> NIL then DeleteExtIO( IOStdReqPtr(Sreq) );
  58.   If  Sport <> NIL then DeletePort( Sport );
  59.   If  txt   <> NIL then FreeString ( txt );
  60.  
  61.   If why <> NIL then WriteLn( why );
  62.   Exit( rt );
  63. End;
  64.  
  65.  
  66.  
  67.  
  68. BEGIN
  69.   txt := AllocString( 80 );
  70.  
  71.   Write("\n Speak V1.0 by Diesel, made in PCQ-Pascal.\n\n RETURN = quit\n");
  72.  
  73.   { * Translator.library öffnen * }
  74.   TranslatorBase := OpenLibrary("translator.library", 32 );
  75.   If TranslatorBase = NIL then CleanExit("Kann translator.lib nicht öffnen",20);
  76.  
  77.   { * Ausgabekanäle definieren * }
  78.   channels[0]:=3; channels[1]:=5; channels[2]:=10; channels[3]:=12;
  79.   
  80.   { * Port einrichten * }
  81.   Sport:=CreatePort(NIL,0);
  82.   If Sport = NIL then CleanExit("Kann MsgPort nicht einrichten.",5);
  83.  
  84.   { * Request einrichten * }
  85.   Sreq:=CreateExtIO(Sport,SizeOf(Narrator_rb));
  86.   If Sreq = NIL then CleanExit("Kann ExtIOReq nicht einrichten.",5);
  87.  
  88.   { * Device öffnen * }
  89.   OpDv :=OpenDevice( "narrator.device", 0, Sreq, 0 );
  90.   If OpDv <> 0 then CleanExit("Kann narrator.device nicht öffnen",10);
  91.  
  92.   { * Hauptschleife * }
  93.   Repeat
  94.     for i := 0 to 500 do begin        { * Clear transl.puffer * }
  95.       xbuf[i] := chr(0);
  96.     End;
  97.  
  98.     Write("Zu sprechender Text: ");    { * Text eingeben * }
  99.     Readln( txt );
  100.     If strlen( txt )>0 then begin
  101.  
  102.       { * Text übersetzen (in Phonem-Codes) * }
  103.       error := Translate( txt, strlen(txt), ADR(Xbuf), 500);
  104.  
  105.       If error=0 Then begin
  106.  
  107.         With Sreq^ Do begin
  108.           message.io_command:=CMD_write;{ * Kommando: ausgeben       * }
  109.           message.io_data   :=ADR(Xbuf);{ * Adresse des Phonem-Puf.  * }
  110.           message.io_length :=500;    { * Länge des Puffers        * }
  111.           rate     := 120;        { * 100 Wörter pro Minute    * }
  112.           pitch    := 80;        { * Stimmlage 230            * }
  113.           sex      := male;        { * weibliche Stimme         * }
  114.           mode     := naturalF0;    { * natürlich betont         * }
  115.           ch_Masks := ADR(channels[0]);    { * Adresse des Kanal-Arrays * }
  116.           nm_Masks := 4;        { * alle 4 Kanäle            * }
  117.           volume   := 64;        { * Lautstärke 64            * }
  118.           sampFreq := 22200;        { * Samplingfrequenz 28000   * }
  119.         End;
  120.  
  121.         error := DoIO( Sreq );        { *          GO !!           * }
  122.         If (error <> 0) then Writeln("Error on DoIO()");
  123.       End;
  124.     End;
  125.  
  126.   Until strlen( txt ) = 0;
  127.  
  128.   { * Arbeit beendet, hinterlasse geordneten Zustand ! * }
  129.   CleanExit( NIL, 0 );
  130.  
  131. END.
  132.